home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / dtcqtest.arc / DTCQTEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-12-01  |  7.9 KB  |  246 lines
  1. program dtctest;
  2.  
  3.  {$v-}
  4.  {$c-}
  5.  {$i-}
  6.  {$r-}
  7.  {$u-}
  8.  {$k-}
  9.  
  10.  const ploton=^f;plotoff=^[^f;cr=^m;lf=^j;
  11.  
  12.  type testidtype=(hrt,vrt,dst,shft,xt);str255=string[255];
  13.   regpack=record
  14.    ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
  15.   end;
  16.  var which:testidtype;portno:integer;biospack:regpack;chb:char;
  17.  
  18.  procedure setupport;
  19.   begin
  20.    biospack.ax:=$5a;      { $5a  =  010 11 0 10               }
  21.                                   {   |  | |  |-- 7 bits/char }
  22.                                   {   |  | |----- 1 stop bit  }
  23.                                   {   |  |------- even parity }
  24.                                   {   |---------- 300 baud    }
  25.    biospack.dx:=portno;
  26.    intr($14,biospack); {call rs232_io bios routine to setup comm port}
  27.  
  28.   end; {setupport}
  29.  
  30.  procedure print(ptext:str255);
  31.   var i,inch,outch,cstat:integer;
  32.   begin
  33.    for i:=1 to length(ptext) do begin
  34.     outch:=$0100 or ord(ptext[i]); {ah=1 to send, al=char to send}
  35.     biospack.dx:=portno;
  36.     repeat
  37.      biospack.ax:=$0300; {get status and see if a char is ready}
  38.      intr($14,biospack);
  39.      if (hi(biospack.ax) and $01) = 1 then begin
  40.       biospack.ax:=$0200; {receive a char}
  41.       intr($14,biospack); {see if ^s was pressed}
  42.       cstat:=hi(biospack.ax);
  43.       inch:=lo(biospack.ax);
  44.       if (cstat = 0) and (inch = 19) then repeat
  45.        biospack.ax:=$0200;
  46.        intr($14,biospack);
  47.        cstat:=hi(biospack.ax);
  48.        inch:=lo(biospack.ax);
  49.                                           until (cstat=0) and (inch=17);
  50.                                            end;
  51.      biospack.ax:=outch;
  52.      intr($14,biospack);
  53.      cstat:=hi(biospack.ax);
  54.     until cstat and $80 = 0;
  55.                                 end;
  56.   end; {print}
  57.  
  58.  procedure runmsg(testname:str255);
  59.   var i:integer;
  60.   begin
  61.    clrscr;
  62.    i:=length(testname) div 2;
  63.    if i<32 then i:=32-i else i:=1;
  64.    highvideo;
  65.    gotoxy(i,12);write(concat('*** RUNNING ',testname,' ***'));
  66.    gotoxy(27,15);write('PRESS ANY KEY TO KILL TEST');
  67.    lowvideo;
  68.    print(cr+lf+'*** '+testname+' ***');
  69.   end; {runmsg}
  70.  
  71.  procedure ready;
  72.   var yesno:char;
  73.   begin
  74.    clrscr;
  75.    repeat
  76.     gotoxy(15,12);write('Is PITCH set to 12 and ELITE 12 wheel installed ? ');
  77.     read(yesno);
  78.    until (upcase(yesno)='Y');
  79.    repeat
  80.     gotoxy(15,13);write('Which comm port is the DTC cabled to (1/2) ? ');
  81.     read(yesno);
  82.    until (yesno='1') or (yesno='2');
  83.    portno:=ord(yesno)-49;
  84.    repeat
  85.     gotoxy(15,14);write('Is the DTC on-line and is PLOT switch set to ON ? ');
  86.     read(yesno);
  87.    until (upcase(yesno)='Y');
  88.   end; {ready}
  89.  
  90.  procedure dohrt;
  91.   label killtest;
  92.   var i:integer;spaces:string[80];
  93.  
  94.   procedure newline;
  95.    begin
  96.     print(plotoff+cr+lf+ploton);
  97.    end; {newline}
  98.  
  99.   begin
  100.    print(plotoff);
  101.    runmsg('HORIZONTAL RESOLUTION TEST');
  102.    newline;
  103.    for i:=1 to 512 do if keypressed then goto killtest
  104.                                     else print('| ');
  105.    newline;spaces:=' ';
  106.    for i:=1 to 256 do if keypressed then goto killtest
  107.                                     else print(spaces+'|'+spaces);
  108.    newline;print(' ');spaces:=spaces+spaces;
  109.    for i:=1 to 128 do if keypressed then goto killtest
  110.                                     else print (spaces+'|'+spaces);
  111.    newline;print('   ');spaces:=spaces+spaces;
  112.    for i:=1 to 64 do if keypressed then goto killtest
  113.                                    else print(spaces+'|'+spaces);
  114.    newline;print('       ');spaces:=spaces+spaces;
  115.    for i:=1 to 32 do if keypressed then goto killtest
  116.                                    else print(spaces+'|'+spaces);
  117.    newline;print('               ');spaces:=spaces+spaces;
  118.    for i:=1 to 16 do if keypressed then goto killtest
  119.                                    else print(spaces+'|'+spaces);
  120.    newline;print('                               ');spaces:=spaces+spaces;
  121.    for i:=1 to 8 do if keypressed then goto killtest
  122.                                   else print(spaces+'|'+spaces);
  123.    newline;
  124.    killtest:print(plotoff+cr+lf);
  125.   end; {dohrt}
  126.  
  127.  procedure dovrt;
  128.   label killtest;
  129.   var i:integer;
  130.  
  131.   procedure testline(dtext:str255);
  132.    begin
  133.     print(dtext);
  134.     if not keypressed then print(cr+ploton+lf+plotoff);
  135.    end; {testline}
  136.  
  137.   begin
  138.    print(plotoff+cr+lf);
  139.    runmsg('VERTICAL RESOLUTION TEST');
  140.    print(cr+lf);
  141.    for i:=1 to 16 do begin
  142.     testline('-----'); if keypressed then goto killtest;
  143.     testline('-');     if keypressed then goto killtest;
  144.     testline('--');    if keypressed then goto killtest;
  145.     testline('-');     if keypressed then goto killtest;
  146.     testline('---');   if keypressed then goto killtest;
  147.     testline('-');     if keypressed then goto killtest;
  148.     testline('--');    if keypressed then goto killtest;
  149.     testline('-');     if keypressed then goto killtest;
  150.     testline('----');  if keypressed then goto killtest;
  151.     testline('-');     if keypressed then goto killtest;
  152.     testline('--');    if keypressed then goto killtest;
  153.     testline('-');     if keypressed then goto killtest;
  154.     testline('---');   if keypressed then goto killtest;
  155.     testline('-');     if keypressed then goto killtest;
  156.     testline('--');    if keypressed then goto killtest;
  157.     testline('-');     if keypressed then goto killtest;
  158.                      end;
  159.    killtest:print(plotoff+cr+lf);
  160.   end; {dovrt}
  161.  
  162.  procedure dodst;
  163.   label killtest;
  164.   var i:integer;
  165.  
  166.   begin
  167.    runmsg('DESCENDERS TEST');
  168.    for i:=1 to 16 do begin
  169.     print(plotoff+cr+lf);
  170.     print('__________________________________________________________'+cr+lf);
  171.     if keypressed then goto killtest;
  172.     print(';;;;;;QQQQQ......,,,,,,yyyyyyypppppppgggggggjjjjjjj3333333'+cr+lf);
  173.     if keypressed then goto killtest;
  174.                      end;
  175.     killtest:;
  176.   end; {dodst}
  177.  
  178.  procedure doshft;
  179.   label killtest;
  180.   var i:integer;
  181.  
  182.   begin
  183.    runmsg('SHORT HAMMER FIRE TEST');
  184.    for i:=1 to 16 do begin
  185.     print(plotoff+cr+lf);
  186.     if keypressed then goto killtest;
  187.     print(',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,'+cr+lf);
  188.     if keypressed then goto killtest;
  189.     print('..........................................................'+cr+lf);
  190.     if keypressed then goto killtest;
  191.     print('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'+cr+lf);
  192.     if keypressed then goto killtest;
  193.     print('//////////////////////////////////////////////////////////'+cr+lf);
  194.     if keypressed then goto killtest;
  195.     print('----------------------------------------------------------'+cr+lf);
  196.     if keypressed then goto killtest;
  197.     print('\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'+cr+lf);
  198.     if keypressed then goto killtest;
  199.     print('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'+cr+lf);
  200.     if keypressed then goto killtest;
  201.     print('""""""""""""""""""""""""""""""""""""""""""""""""""""""""""'+cr+lf);
  202.                      end;
  203.     killtest:;
  204.   end; {doshft}
  205.  
  206.  procedure menu(var testid:testidtype);
  207.   var choice:char;
  208.   begin
  209.    clrscr;
  210.    gotoxy(20,1);
  211.    highvideo;write('*** DTC PRINT QUALITY TEST ***');
  212.    gotoxy(20,3);write('1:Horizontal Resolution Test');
  213.    gotoxy(20,4);write('2:Vertical Resolution Test');
  214.    gotoxy(20,5);write('3:Descenders Test');
  215.    gotoxy(20,6);write('4:Short Hammer Fire Test');
  216.    gotoxy(20,7);write('5:Exit Tests');
  217.    repeat
  218.     gotoxy(8,9);highvideo;write('Selection ? ');
  219.     highvideo;read(choice);
  220.    until choice in ['1'..'5'];
  221.    case choice of
  222.     '1':testid:=hrt;
  223.     '2':testid:=vrt;
  224.     '3':testid:=dst;
  225.     '4':testid:=shft;
  226.     '5':testid:=xt;
  227.    end;
  228.   end; {menu}
  229.  
  230.  begin {dtctest}
  231.   ready;
  232.   setupport;
  233.   repeat
  234.    menu(which);
  235.    case which of
  236.     hrt:dohrt;
  237.     vrt:dovrt;
  238.     dst:dodst;
  239.     shft:doshft;
  240.     xt:;
  241.    end;
  242.   while keypressed do read(kbd,chb);
  243.   until which=xt;
  244.   textmode(bw80);
  245.   print(plotoff+cr+lf);
  246.  end. {dtctest}